home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Yerk 3.6.6 / Module source / Util < prev    next >
Encoding:
Text File  |  1994-01-18  |  6.2 KB  |  87 lines  |  [TEXT/YERK]
  1. \ Utility words for Yerk
  2. \ 10/13/84  CBD Combined with Dump.scr
  3. \ 12/16/84  CBD Made into a module
  4. \  1/04/85  cdn Moved in objList
  5. \  7/10/86  cdn Moved in .classes
  6. \  9/02/86  cdn Added Option & Shift key features to WORDS
  7. \  9/04/86  ghs Added pat
  8. \ 12/04/87  rfl modified .cline to use better format and increased clist size
  9. \ 12/04/87    rfl fixed dump format
  10. \ 10/02/90    rfl    .pause now in nucleus
  11. \ 10/26/91    rfl    added class hierarchy
  12. \ 12/14/91    rfl    modified .class to not be reentrant..runs out of stack
  13. \ 12/1
  14.                 THEN
  15.           THEN
  16.     UNTIL ind  ;
  17.  
  18. : classTrav { ind -- }
  19.     BEGIN ?terminal
  20.           IF (key) drop cr .pause (key)
  21.              cr 0 -> out 32 > IF exit THEN
  22.           THEN
  23.           ind .cline
  24.           ind ?sub                            \ does it have a subclass?
  25.           IF   1 ++> level -> ind            \ yes, so dip down and save last class index
  26.           ELSE findPeer    -> ind                \ otherwise find next peer
  27.           THEN
  28.           ind not
  29.     UNTIL ;
  30.  
  31. : .cl  size: clist 0 DO i at: clist cr nfa id. LOOP  ;
  32.  
  33. : .classes 0 -> level 0 -> #obs
  34.     400 heap> Ordered-Col -> cList
  35.     fillClist  size: clist 1-  classTrav level 0 do drop loop cr cr
  36.     size: clist ." number of classes is " . cr 
  37.     #obs ." number of objects is " . cr
  38.     dispose> cList ;
  39.  
  40. rect pbox
  41.  
  42. \ Display the system pen patterns
  43. : pat { \ pattern -- }
  44.     0 -> pattern -curs cls
  45.     1 8 50 38 put: pbox 6 0
  46.     DO    7 0
  47.         DO    pattern 38 = IF 3 sysPat +base call PenPat THEN
  48.             55 0 offset: pbox  pattern sysPat fill: pbox  draw: pbox
  49.             getBotX: pbox 38 -  getBotY: pbox 9 +  gotoxy  pattern .
  50.             1 ++> pattern
  51.         LOOP
  52.         -385 40 offset: pbox
  53.     LOOP
  54.     0 sysPat +base call PenPat
  55.     CR +curs
  56. ;
  57.  
  58.  
  59. \ ************
  60. \ : (chain) { myobj \ tab -- } cr 0 -> tab
  61. \         BEGIN  2 ++> tab myObj sfa @ -> myObj
  62. \                myObj nfa n>count 2dup tab spaces type cr " OBJECT" s=
  63. \         UNTIL ;
  64.  
  65. : (chain) { myObj \ tab -- } 40 heap> ordered-col -> clist
  66.         cr 0 -> tab myObj add: clist
  67.         BEGIN    myObj sfa @ -> myObj
  68.                 myObj add: clist
  69.                 myObj nfa n>count  " OBJECT" s=
  70.         UNTIL 
  71.         size: clist 0
  72.         DO  2 ++> tab last: clist nfa n>count tab spaces type cr
  73.             size: clist 1- remove: clist
  74.         LOOP dispose> clist ;
  75.  
  76. : hc'
  77.     @word count sfind
  78.     IF drop (chain) THEN ;
  79.  
  80. : hier  " List class hierarchy of class:" doInDlg
  81.         IF  sFind 0= Abort" not found"
  82.             drop ?isclass IF (chain) ELSE abort" not a class" THEN
  83.         THEN ;
  84.  
  85.  
  86. ;Module
  87.